home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Publication 6
/
Publication_06_19xx_High-Tech_de_Side_B.d64
/
d 3
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2023-02-26
|
3KB
|
86 lines
1000 poke56334,peek(56334)or1:rem(NULL)
1001 poke848,169:poke849,32:poke850,162:poke851,0:poke852,157:poke853,120:poke854,4
1002 poke855,157:poke856,24:poke857,5:poke858,157:poke859,184:poke860,5:poke861,157:poke862,128
1003 poke863,6:poke864,157:poke865,248:poke866,6:poke867,232:poke868,208:poke869,238:poke870,96
1020 print"":poke204,1:input"[215]ieviele [205]onate ausgeben12[157][157][157][157]";mq
1022 ifmq=0thenprint"[145][145][145][145]":goto1020
1024 ifmq>12thenprint"[145][145][145][145]":goto1020
1040 t=gt:m=gm:j=gj:gosub1630:at=x:rem(NULL)
1050 zu=int((40-len(n$))/2):ifhj/4<>int(hj/4)andhm=1thenl(2)=28:rem(NULL)
1060 ifhm>3and(hj+1)/4<>int((hj+1)/4)thenl(2)=28:rem(NULL)
1070 print"[147] [194]iorhythmus [146]";
1080 printleft$(" ",zu);
1090 printn$:rem(NULL)
1100 n$="geb. am "+t$+",d."+str$(gt)+"."+m$(gm)+str$(gj):rem(NULL)
1110 zu=int((40-len(n$))/2)
1120 printleft$(" ",zu)n$"[144]"
1130 ifhm=1then1180
1140 fora=1tohm-1:forb=1to11
1150 m$(0)=m$(b):m$(b)=m$(b+1):m$(b+1)=m$(0):rem(NULL)
1160 l(0)=l(b):l(b)=l(b+1):l(b+1)=l(0):m(0)=m(b):m(b)=m(b+1):m(b+1)=m(0):rem(NULL)
1170 nextb,a:m(0)=0:rem(NULL)
1180 c=0:fora=1to12:ifa>1andm$(a)="[202]anuar"thenhj=hj+1:c=1:rem(NULL)
1190 m$(a)=m$(a)+str$(hj)
1200 next:ifc=1thenhj=hj-1
1210 fora=1tomq:rs$=" 123456789[146]0[144]123456789[146]0[144]123456789[146]0[144]1[145]"
1220 print""rs$;
1230 rr$="":t=1:m=m(a):j=hj:ifm(a-1)>m(a)thenhj=hj+1:j=hj
1240 zu=int((24-len(m$(a)))/2):wa$=left$("",zu)+m$(a):print""
1250 forwa=1tozu+len(m$(a)):print""mid$(wa$,wa,1)
1260 print"[145]"spc(38)mid$(wa$,wa,1):next
1270 gosub1630
1280 ifl(a)=28thenx=x+3
1290 ifl(a)=29thenx=x+2
1300 ta=x-at:g1=ta-33*int(ta/33):s1=ta-28*int(ta/28):k1=ta-23*int(ta/23)
1310 al(a)=ta
1320 s1$=chr$(125)+chr$(125)+chr$(125)+"pos."+chr$(125)+chr$(125)+chr$(125)
1330 s1$=s1$+chr$(125)+chr$(125)+chr$(125)+chr$(125)+"neg."
1340 s1$=s1$+chr$(125)+chr$(125)+chr$(125)
1350 print"":forwa=1to21:print""mid$(s1$,wa,1):next
1360 forb=1to31
1370 s1$=".........."+chr$(45)+".........."
1380 ifb>l(a)then1440
1390 g1=g1+1:s1=s1+1:k1=k1+1
1400 ifg1>33theng1=1
1410 ifs1>28thens1=1
1420 ifk1>23thenk1=1
1430 :
1440 ifb>l(a)then1490
1450 s1$=left$(s1$,g(g1)-1)+"[199]"+mid$(s1$,g(g1)+1)
1460 s1$=left$(s1$,s(s1)-1)+"[211]"+mid$(s1$,s(s1)+1)
1470 s1$=left$(s1$,k(k1)-1)+"[203]"+mid$(s1$,k(k1)+1)
1480 rs$="[145]":forwa=21to1step-1:printrr$rs$mid$(s1$,wa,1);:rs$=""+rs$:next:rr$=rr$+""
1490 nextb:poke198,0:wait198,1:print"":sys848
1500 nexta
1510 fora=1to16:readav:ifav=>al(1)andav<=al(12)+l(12)thena=16:goto1530
1520 nexta:goto1620
1530 fora=1to12:ifav=>al(a)andav<=al(a)+l(a)thenb=a:a=12:goto1550
1540 nexta:
1550 fora=2tob:ifm(a-1)>m(a)thenj1=j1+1
1560 nexta:t=av-al(b):m=m(b):j=j1:gosub1630
1570 print"----------------------------------------"
1580 print:print"[201]ch habe noch einen [199]rund zum [198]eiern fuer [211]ie :"
1590 print
1600 print"[193]m "t$", dem "right$(str$(t),2)"."right$(str$(m(b)),2)".";j1
1610 print"werden [211]ie"av"[212]age alt"
1620 print" noch einmal ? (j/n)"
1622 geta$:ifa$<>"j"anda$<>"n"then1622
1624 ifa$="n"thenforx=2200to2300:pokex,0:next:sys64738
1626 run
1630 rem alter und wochentag
1640 z=0:ifm<2theny=(m-1)*31:goto1680
1650 ifj/4<>int(j/4)then1670
1660 ifj/100<>int(j/100)thenz=1
1670 y=int((306*m-324)/10)
1680 z=z+int(j-1)*365+int((j-1)/4)
1690 z=z-int((j-1)/100)+int((j-1)/400)
1700 x=z+y+t:w=(x-int(x/7)*7)+1
1710 onwgoto1720,1730,1740,1750,1760,1770,1780
1720 t$="[211]onntag":return
1730 t$="[205]ontag":return
1740 t$="[196]ienstag":return
1750 t$="[205]ittwoch":return
1760 t$="[196]onnerstag":return
1770 t$="[198]reitag":return
1780 t$="[211]amstag":return